<html>
<head>
<title>E:\QProjects\Lisp\toygen\inter\typesystem.lisp.html</title>
<meta name="Generator" content="Vim/7.0">
<meta http-equiv="content-type" content="text/html; charset=windows-1251">
</head>
<body bgcolor="#ffffff" text="#000000">
<pre>
<font color="#804040"> 1 </font><span class="Comment">;</span>
<font color="#804040"> 2 </font><span class="Comment">; defines types manipulation routines and types registration facility</span>
<font color="#804040"> 3 </font><span class="Comment">;</span>
<font color="#804040"> 4 </font><span class="Comment">; main entities are:</span>
<font color="#804040"> 5 </font><span class="Comment">;</span>
<font color="#804040"> 6 </font><span class="Comment">;   get-type-info</span>
<font color="#804040"> 7 </font><span class="Comment">;   type-info</span>
<font color="#804040"> 8 </font><span class="Comment">;   add-primitive-type-mappings</span>
<font color="#804040"> 9 </font><span class="Comment">;</span>
<font color="#804040">10 </font>
<font color="#804040">11 </font><span class="Special">(</span><span class="Statement">defparameter</span><span class="lispList"> </span><span class="Type">*primitive-type-mappings*</span><span class="lispList"> </span><span class="Special">(</span><span class="Statement">make-hash-table</span><span class="Special">))</span>
<font color="#804040">12 </font>
<font color="#804040">13 </font><span class="Special">(</span><span class="Statement">defun</span><span class="lispList"> </span><span class="lispSymbol">get-type-info</span><span class="lispList"> </span><span class="Special">(</span><span class="lispSymbol">type-sym</span><span class="Special">)</span>
<font color="#804040">14 </font><span class="lispLeadWhite">  </span><span class="Special">(</span><span class="Statement">let</span><span class="lispList"> </span><span class="Special">((</span><span class="lispSymbol">result</span><span class="lispList"> </span><span class="Special">(</span><span class="Statement">gethash</span><span class="lispList"> </span><span class="lispSymbol">type-sym</span><span class="lispList"> </span><span class="Type">*primitive-type-mappings*</span><span class="Special">)))</span>
<font color="#804040">15 </font><span class="lispLeadWhite">    </span><span class="Special">(</span><span class="Statement">unless</span><span class="lispList"> </span><span class="lispSymbol">result</span><span class="lispList"> </span><span class="Special">(</span><span class="Statement">error</span><span class="lispList"> </span><span class="Constant">&quot;type is not found in the mapping table&quot;</span><span class="Special">))</span>
<font color="#804040">16 </font><span class="lispLeadWhite">    </span><span class="lispSymbol">result</span><span class="Special">))</span>
<font color="#804040">17 </font>
<font color="#804040">18 </font><span class="Special">(</span><span class="Statement">defstruct</span><span class="lispList"> </span><span class="Special">(</span><span class="lispSymbol">type-info</span>
<font color="#804040">19 </font><span class="lispLeadWhite">            </span><span class="Special">(</span><span class="Type">:constructor</span>
<font color="#804040">20 </font><span class="lispLeadWhite">             </span><span class="lispSymbol">create-type-info</span><span class="lispList"> </span><span class="Special">(</span><span class="lispSymbol">&amp;key</span><span class="lispList"> </span><span class="lispSymbol">lang-name</span><span class="lispList"> </span><span class="lispSymbol">size</span><span class="Special">)))</span>
<font color="#804040">21 </font><span class="lispLeadWhite">  </span><span class="lispSymbol">lang-name</span>
<font color="#804040">22 </font><span class="lispLeadWhite">  </span><span class="lispSymbol">size</span>
<font color="#804040">23 </font><span class="lispLeadWhite">  </span><span class="Special">)</span>
<font color="#804040">24 </font>
<font color="#804040">25 </font><span class="Special">(</span><span class="Statement">defun</span><span class="lispList"> </span><span class="lispSymbol">add-primitive-type-mappings</span><span class="lispList"> </span><span class="Special">(</span><span class="lispSymbol">mappings-list</span><span class="Special">)</span>
<font color="#804040">26 </font><span class="lispLeadWhite">  </span><span class="Special">(</span><span class="Statement">dolist</span><span class="lispList"> </span><span class="Special">(</span><span class="lispSymbol">type-mapping</span><span class="lispList"> </span><span class="lispSymbol">mappings-list</span><span class="Special">)</span>
<font color="#804040">27 </font><span class="lispLeadWhite">    </span><span class="Special">(</span><span class="Statement">let</span><span class="lispList"> </span><span class="Special">((</span><span class="lispSymbol">sym-type</span><span class="lispList"> </span><span class="Special">(</span><span class="Statement">first</span><span class="lispList"> </span><span class="lispSymbol">type-mapping</span><span class="Special">))</span>
<font color="#804040">28 </font><span class="lispLeadWhite">          </span><span class="Special">(</span><span class="lispSymbol">type-inst</span><span class="lispList"> </span><span class="Special">(</span><span class="Statement">eval</span><span class="lispList"> </span><span class="Special">(</span><span class="Statement">append</span><span class="lispList"> </span><span class="Special">(</span><span class="Statement">list</span><span class="lispList"> </span><span class="Special">'</span><span class="Identifier">create-type-info</span><span class="Special">)</span><span class="lispList"> </span><span class="Special">(</span><span class="Statement">cdr</span><span class="lispList"> </span><span class="lispSymbol">type-mapping</span><span class="Special">))))</span>
<font color="#804040">29 </font><span class="lispLeadWhite">          </span><span class="Special">)</span>
<font color="#804040">30 </font><span class="lispLeadWhite">      </span><span class="Special">(</span><span class="Statement">assert</span><span class="lispList"> </span><span class="Special">(</span><span class="Statement">symbolp</span><span class="lispList"> </span><span class="lispSymbol">sym-type</span><span class="Special">))</span>
<font color="#804040">31 </font>
<font color="#804040">32 </font><span class="lispLeadWhite">      </span><span class="Special">(</span><span class="Statement">if</span><span class="lispList"> </span><span class="Special">(</span><span class="Statement">gethash</span><span class="lispList"> </span><span class="lispSymbol">sym-type</span><span class="lispList"> </span><span class="Type">*primitive-type-mappings*</span><span class="Special">)</span>
<font color="#804040">33 </font><span class="lispLeadWhite">          </span><span class="Special">(</span><span class="Statement">error</span><span class="lispList"> </span><span class="Constant">&quot;the symbol is already mapped&quot;</span><span class="Special">))</span>
<font color="#804040">34 </font>
<font color="#804040">35 </font><span class="lispLeadWhite">      </span><span class="Special">(</span><span class="Statement">setf</span><span class="lispList"> </span><span class="Special">(</span><span class="Statement">gethash</span><span class="lispList"> </span><span class="lispSymbol">sym-type</span><span class="lispList"> </span><span class="Type">*primitive-type-mappings*</span><span class="Special">)</span><span class="lispList"> </span><span class="lispSymbol">type-inst</span><span class="Special">)</span>
<font color="#804040">36 </font><span class="lispLeadWhite">      </span><span class="Special">)))</span>
</pre>
</body>
</html>
